home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / PERL / UNTESTED / X2P / A2PY.C < prev    next >
C/C++ Source or Header  |  1992-01-05  |  25KB  |  1,283 lines
  1. /* $RCSfile: a2py.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:12:59 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    a2py.c,v $
  9.  * Revision 4.0.1.1  91/06/07  12:12:59  lwall
  10.  * patch4: new copyright notice
  11.  * 
  12.  * Revision 4.0  91/03/20  01:57:26  lwall
  13.  * 4.0 baseline.
  14.  * 
  15.  */
  16.  
  17. #ifdef MSDOS
  18. #include "../patchlev.h"
  19. #endif
  20. #include "util.h"
  21. char *index();
  22.  
  23. char *filename;
  24. char *myname;
  25.  
  26. int checkers = 0;
  27. STR *walk();
  28.  
  29. #ifdef MSDOS
  30. usage()
  31. {
  32.     printf("\nThis is the AWK to PERL translator, version 3.0, patchlevel %d\n", PATCHLEVEL);
  33.     printf("\nUsage: %s [-D<number>] [-F<char>] [-n<fieldlist>] [-<number>] filename\n", myname);
  34.     printf("\n  -D<number>      sets debugging flags."
  35.            "\n  -F<character>   the awk script to translate is always invoked with"
  36.            "\n                  this -F switch."
  37.            "\n  -n<fieldlist>   specifies the names of the input fields if input does"
  38.            "\n                  not have to be split into an array."
  39.            "\n  -<number>       causes a2p to assume that input will always have that"
  40.            "\n                  many fields.\n");
  41.     exit(1);
  42. }
  43. #endif
  44. main(argc,argv,env)
  45. register int argc;
  46. register char **argv;
  47. register char **env;
  48. {
  49.     register STR *str;
  50.     register char *s;
  51.     int i;
  52.     STR *tmpstr;
  53.  
  54.     myname = argv[0];
  55.     linestr = str_new(80);
  56.     str = str_new(0);        /* first used for -I flags */
  57.     for (argc--,argv++; argc; argc--,argv++) {
  58.     if (argv[0][0] != '-' || !argv[0][1])
  59.         break;
  60.       reswitch:
  61.     switch (argv[0][1]) {
  62. #ifdef DEBUGGING
  63.     case 'D':
  64.         debug = atoi(argv[0]+2);
  65. #ifdef YYDEBUG
  66.         yydebug = (debug & 1);
  67. #endif
  68.         break;
  69. #endif
  70.     case '0': case '1': case '2': case '3': case '4':
  71.     case '5': case '6': case '7': case '8': case '9':
  72.         maxfld = atoi(argv[0]+1);
  73.         absmaxfld = TRUE;
  74.         break;
  75.     case 'F':
  76.         fswitch = argv[0][2];
  77.         break;
  78.     case 'n':
  79.         namelist = savestr(argv[0]+2);
  80.         break;
  81.     case '-':
  82.         argc--,argv++;
  83.         goto switch_end;
  84.     case 0:
  85.         break;
  86.     default:
  87.         fatal("Unrecognized switch: %s\n",argv[0]);
  88. #ifdef MSDOS
  89.             usage();
  90. #endif
  91.     }
  92.     }
  93.   switch_end:
  94.  
  95.     /* open script */
  96.  
  97.     if (argv[0] == Nullch) {
  98. #ifdef MSDOS
  99.     if ( isatty(fileno(stdin)) )
  100.         usage();
  101. #endif
  102.         argv[0] = "-";
  103.     }
  104.     filename = savestr(argv[0]);
  105.  
  106.     filename = savestr(argv[0]);
  107.     if (strEQ(filename,"-"))
  108.     argv[0] = "";
  109.     if (!*argv[0])
  110.     rsfp = stdin;
  111.     else
  112.     rsfp = fopen(argv[0],"r");
  113.     if (rsfp == Nullfp)
  114.     fatal("Awk script \"%s\" doesn't seem to exist.\n",filename);
  115.  
  116.     /* init tokener */
  117.  
  118.     bufptr = str_get(linestr);
  119.     symtab = hnew();
  120.     curarghash = hnew();
  121.  
  122.     /* now parse the report spec */
  123.  
  124.     if (yyparse())
  125.     fatal("Translation aborted due to syntax errors.\n");
  126.  
  127. #ifdef DEBUGGING
  128.     if (debug & 2) {
  129.     int type, len;
  130.  
  131.     for (i=1; i<mop;) {
  132.         type = ops[i].ival;
  133.         len = type >> 8;
  134.         type &= 255;
  135.         printf("%d\t%d\t%d\t%-10s",i++,type,len,opname[type]);
  136.         if (type == OSTRING)
  137.         printf("\t\"%s\"\n",ops[i].cval),i++;
  138.         else {
  139.         while (len--) {
  140.             printf("\t%d",ops[i].ival),i++;
  141.         }
  142.         putchar('\n');
  143.         }
  144.     }
  145.     }
  146.     if (debug & 8)
  147.     dump(root);
  148. #endif
  149.  
  150.     /* first pass to look for numeric variables */
  151.  
  152.     prewalk(0,0,root,&i);
  153.  
  154.     /* second pass to produce new program */
  155.  
  156.     tmpstr = walk(0,0,root,&i,P_MIN);
  157.     str = str_make("#!");
  158.     str_cat(str, BIN);
  159.     str_cat(str, "/perl\neval \"exec ");
  160.     str_cat(str, BIN);
  161.     str_cat(str, "/perl -S $0 $*\"\n\
  162.     if $running_under_some_shell;\n\
  163.             # this emulates #! processing on NIH machines.\n\
  164.             # (remove #! line above if indigestible)\n\n");
  165.     str_cat(str,
  166.       "eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;\n");
  167.     str_cat(str,
  168.       "            # process any FOO=bar switches\n\n");
  169.     if (do_opens && opens) {
  170.     str_scat(str,opens);
  171.     str_free(opens);
  172.     str_cat(str,"\n");
  173.     }
  174.     str_scat(str,tmpstr);
  175.     str_free(tmpstr);
  176. #ifdef DEBUGGING
  177.     if (!(debug & 16))
  178. #endif
  179.     fixup(str);
  180.     putlines(str);
  181.     if (checkers) {
  182.     fprintf(stderr,
  183.       "Please check my work on the %d line%s I've marked with \"#???\".\n",
  184.         checkers, checkers == 1 ? "" : "s" );
  185.     fprintf(stderr,
  186.       "The operation I've selected may be wrong for the operand types.\n");
  187.     }
  188.     exit(0);
  189. }
  190.  
  191. #define RETURN(retval) return (bufptr = s,retval)
  192. #define XTERM(retval) return (expectterm = TRUE,bufptr = s,retval)
  193. #define XOP(retval) return (expectterm = FALSE,bufptr = s,retval)
  194. #define ID(x) return (yylval=string(x,0),expectterm = FALSE,bufptr = s,idtype)
  195.  
  196. int idtype;
  197.  
  198. yylex()
  199. {
  200.     register char *s = bufptr;
  201.     register char *d;
  202.     register int tmp;
  203.  
  204.   retry:
  205. #ifdef YYDEBUG
  206.     if (yydebug)
  207.     if (index(s,'\n'))
  208.         fprintf(stderr,"Tokener at %s",s);
  209.     else
  210.         fprintf(stderr,"Tokener at %s\n",s);
  211. #endif
  212.     switch (*s) {
  213.     default:
  214.     fprintf(stderr,
  215.         "Unrecognized character %c in file %s line %d--ignoring.\n",
  216.          *s++,filename,line);
  217.     goto retry;
  218.     case '\\':
  219.     case 0:
  220.     s = str_get(linestr);
  221.     *s = '\0';
  222.     if (!rsfp)
  223.         RETURN(0);
  224.     line++;
  225.     if ((s = str_gets(linestr, rsfp)) == Nullch) {
  226.         if (rsfp != stdin)
  227.         fclose(rsfp);
  228.         rsfp = Nullfp;
  229.         s = str_get(linestr);
  230.         RETURN(0);
  231.     }
  232.     goto retry;
  233.     case ' ': case '\t':
  234.     s++;
  235.     goto retry;
  236.     case '\n':
  237.     *s = '\0';
  238.     XTERM(NEWLINE);
  239.     case '#':
  240.     yylval = string(s,0);
  241.     *s = '\0';
  242.     XTERM(COMMENT);
  243.     case ';':
  244.     tmp = *s++;
  245.     if (*s == '\n') {
  246.         s++;
  247.         XTERM(SEMINEW);
  248.     }
  249.     XTERM(tmp);
  250.     case '(':
  251.     tmp = *s++;
  252.     XTERM(tmp);
  253.     case '{':
  254.     case '[':
  255.     case ')':
  256.     case ']':
  257.     case '?':
  258.     case ':':
  259.     tmp = *s++;
  260.     XOP(tmp);
  261.     case 127:
  262.     s++;
  263.     XTERM('}');
  264.     case '}':
  265.     for (d = s + 1; isspace(*d); d++) ;
  266.     if (!*d)
  267.         s = d - 1;
  268.     *s = 127;
  269.     XTERM(';');
  270.     case ',':
  271.     tmp = *s++;
  272.     XTERM(tmp);
  273.     case '~':
  274.     s++;
  275.     yylval = string("~",1);
  276.     XTERM(MATCHOP);
  277.     case '+':
  278.     case '-':
  279.     if (s[1] == *s) {
  280.         s++;
  281.         if (*s++ == '+')
  282.         XTERM(INCR);
  283.         else
  284.         XTERM(DECR);
  285.     }
  286.     /* FALL THROUGH */
  287.     case '*':
  288.     case '%':
  289.     case '^':
  290.     tmp = *s++;
  291.     if (*s == '=') {
  292.         if (tmp == '^')
  293.         yylval = string("**=",3);
  294.         else
  295.         yylval = string(s-1,2);
  296.         s++;
  297.         XTERM(ASGNOP);
  298.     }
  299.     XTERM(tmp);
  300.     case '&':
  301.     s++;
  302.     tmp = *s++;
  303.     if (tmp == '&')
  304.         XTERM(ANDAND);
  305.     s--;
  306.     XTERM('&');
  307.     case '|':
  308.     s++;
  309.     tmp = *s++;
  310.     if (tmp == '|')
  311.         XTERM(OROR);
  312.     s--;
  313.     while (*s == ' ' || *s == '\t')
  314.         s++;
  315.     if (strnEQ(s,"getline",7))
  316.         XTERM('p');
  317.     else
  318.         XTERM('|');
  319.     case '=':
  320.     s++;
  321.     tmp = *s++;
  322.     if (tmp == '=') {
  323.         yylval = string("==",2);
  324.         XTERM(RELOP);
  325.     }
  326.     s--;
  327.     yylval = string("=",1);
  328.     XTERM(ASGNOP);
  329.     case '!':
  330.     s++;
  331.     tmp = *s++;
  332.     if (tmp == '=') {
  333.         yylval = string("!=",2);
  334.         XTERM(RELOP);
  335.     }
  336.     if (tmp == '~') {
  337.         yylval = string("!~",2);
  338.         XTERM(MATCHOP);
  339.     }
  340.     s--;
  341.     XTERM(NOT);
  342.     case '<':
  343.     s++;
  344.     tmp = *s++;
  345.     if (tmp == '=') {
  346.         yylval = string("<=",2);
  347.         XTERM(RELOP);
  348.     }
  349.     s--;
  350.     XTERM('<');
  351.     case '>':
  352.     s++;
  353.     tmp = *s++;
  354.     if (tmp == '>') {
  355.         yylval = string(">>",2);
  356.         XTERM(GRGR);
  357.     }
  358.     if (tmp == '=') {
  359.         yylval = string(">=",2);
  360.         XTERM(RELOP);
  361.     }
  362.     s--;
  363.     XTERM('>');
  364.  
  365. #define SNARFWORD \
  366.     d = tokenbuf; \
  367.     while (isalpha(*s) || isdigit(*s) || *s == '_') \
  368.         *d++ = *s++; \
  369.     *d = '\0'; \
  370.     d = tokenbuf; \
  371.     if (*s == '(') \
  372.         idtype = USERFUN; \
  373.     else \
  374.         idtype = VAR;
  375.  
  376.     case '$':
  377.     s++;
  378.     if (*s == '0') {
  379.         s++;
  380.         do_chop = TRUE;
  381.         need_entire = TRUE;
  382.         idtype = VAR;
  383.         ID("0");
  384.     }
  385.     do_split = TRUE;
  386.     if (isdigit(*s)) {
  387.         for (d = s; isdigit(*s); s++) ;
  388.         yylval = string(d,s-d);
  389.         tmp = atoi(d);
  390.         if (tmp > maxfld)
  391.         maxfld = tmp;
  392.         XOP(FIELD);
  393.     }
  394.     split_to_array = set_array_base = TRUE;
  395.     XOP(VFIELD);
  396.  
  397.     case '/':            /* may either be division or pattern */
  398.     if (expectterm) {
  399.         s = scanpat(s);
  400.         XTERM(REGEX);
  401.     }
  402.     tmp = *s++;
  403.     if (*s == '=') {
  404.         yylval = string("/=",2);
  405.         s++;
  406.         XTERM(ASGNOP);
  407.     }
  408.     XTERM(tmp);
  409.  
  410.     case '0': case '1': case '2': case '3': case '4':
  411.     case '5': case '6': case '7': case '8': case '9': case '.':
  412.     s = scannum(s);
  413.     XOP(NUMBER);
  414.     case '"':
  415.     s++;
  416.     s = cpy2(tokenbuf,s,s[-1]);
  417.     if (!*s)
  418.         fatal("String not terminated:\n%s",str_get(linestr));
  419.     s++;
  420.     yylval = string(tokenbuf,0);
  421.     XOP(STRING);
  422.  
  423.     case 'a': case 'A':
  424.     SNARFWORD;
  425.     if (strEQ(d,"ARGC"))
  426.         set_array_base = TRUE;
  427.     if (strEQ(d,"ARGV")) {
  428.         yylval=numary(string("ARGV",0));
  429.         XOP(VAR);
  430.     }
  431.     if (strEQ(d,"atan2")) {
  432.         yylval = OATAN2;
  433.         XTERM(FUNN);
  434.     }
  435.     ID(d);
  436.     case 'b': case 'B':
  437.     SNARFWORD;
  438.     if (strEQ(d,"break"))
  439.         XTERM(BREAK);
  440.     if (strEQ(d,"BEGIN"))
  441.         XTERM(BEGIN);
  442.     ID(d);
  443.     case 'c': case 'C':
  444.     SNARFWORD;
  445.     if (strEQ(d,"continue"))
  446.         XTERM(CONTINUE);
  447.     if (strEQ(d,"cos")) {
  448.         yylval = OCOS;
  449.         XTERM(FUN1);
  450.     }
  451.     if (strEQ(d,"close")) {
  452.         do_fancy_opens = 1;
  453.         yylval = OCLOSE;
  454.         XTERM(FUN1);
  455.     }
  456.     if (strEQ(d,"chdir"))
  457.         *d = toupper(*d);
  458.     else if (strEQ(d,"crypt"))
  459.         *d = toupper(*d);
  460.     else if (strEQ(d,"chop"))
  461.         *d = toupper(*d);
  462.     else if (strEQ(d,"chmod"))
  463.         *d = toupper(*d);
  464.     else if (strEQ(d,"chown"))
  465.         *d = toupper(*d);
  466.     ID(d);
  467.     case 'd': case 'D':
  468.     SNARFWORD;
  469.     if (strEQ(d,"do"))
  470.         XTERM(DO);
  471.     if (strEQ(d,"delete"))
  472.         XTERM(DELETE);
  473.     if (strEQ(d,"die"))
  474.         *d = toupper(*d);
  475.     ID(d);
  476.     case 'e': case 'E':
  477.     SNARFWORD;
  478.     if (strEQ(d,"END"))
  479.         XTERM(END);
  480.     if (strEQ(d,"else"))
  481.         XTERM(ELSE);
  482.     if (strEQ(d,"exit")) {
  483.         saw_line_op = TRUE;
  484.         XTERM(EXIT);
  485.     }
  486.     if (strEQ(d,"exp")) {
  487.         yylval = OEXP;
  488.         XTERM(FUN1);
  489.     }
  490.     if (strEQ(d,"elsif"))
  491.         *d = toupper(*d);
  492.     else if (strEQ(d,"eq"))
  493.         *d = toupper(*d);
  494.     else if (strEQ(d,"eval"))
  495.         *d = toupper(*d);
  496.     else if (strEQ(d,"eof"))
  497.         *d = toupper(*d);
  498.     else if (strEQ(d,"each"))
  499.         *d = toupper(*d);
  500.     else if (strEQ(d,"exec"))
  501.         *d = toupper(*d);
  502.     ID(d);
  503.     case 'f': case 'F':
  504.     SNARFWORD;
  505.     if (strEQ(d,"FS")) {
  506.         saw_FS++;
  507.         if (saw_FS == 1 && in_begin) {
  508.         for (d = s; *d && isspace(*d); d++) ;
  509.         if (*d == '=') {
  510.             for (d++; *d && isspace(*d); d++) ;
  511.             if (*d == '"' && d[2] == '"')
  512.             const_FS = d[1];
  513.         }
  514.         }
  515.         ID(tokenbuf);
  516.     }
  517.     if (strEQ(d,"for"))
  518.         XTERM(FOR);
  519.     else if (strEQ(d,"function"))
  520.         XTERM(FUNCTION);
  521.     if (strEQ(d,"FILENAME"))
  522.         d = "ARGV";
  523.     if (strEQ(d,"foreach"))
  524.         *d = toupper(*d);
  525.     else if (strEQ(d,"format"))
  526.         *d = toupper(*d);
  527.     else if (strEQ(d,"fork"))
  528.         *d = toupper(*d);
  529.     else if (strEQ(d,"fh"))
  530.         *d = toupper(*d);
  531.     ID(d);
  532.     case 'g': case 'G':
  533.     SNARFWORD;
  534.     if (strEQ(d,"getline"))
  535.         XTERM(GETLINE);
  536.     if (strEQ(d,"gsub"))
  537.         XTERM(GSUB);
  538.     if (strEQ(d,"ge"))
  539.         *d = toupper(*d);
  540.     else if (strEQ(d,"gt"))
  541.         *d = toupper(*d);
  542.     else if (strEQ(d,"goto"))
  543.         *d = toupper(*d);
  544.     else if (strEQ(d,"gmtime"))
  545.         *d = toupper(*d);
  546.     ID(d);
  547.     case 'h': case 'H':
  548.     SNARFWORD;
  549.     if (strEQ(d,"hex"))
  550.         *d = toupper(*d);
  551.     ID(d);
  552.     case 'i': case 'I':
  553.     SNARFWORD;
  554.     if (strEQ(d,"if"))
  555.         XTERM(IF);
  556.     if (strEQ(d,"in"))
  557.         XTERM(IN);
  558.     if (strEQ(d,"index")) {
  559.         set_array_base = TRUE;
  560.         XTERM(INDEX);
  561.     }
  562.     if (strEQ(d,"int")) {
  563.         yylval = OINT;
  564.         XTERM(FUN1);
  565.     }
  566.     ID(d);
  567.     case 'j': case 'J':
  568.     SNARFWORD;
  569.     if (strEQ(d,"join"))
  570.         *d = toupper(*d);
  571.     ID(d);
  572.     case 'k': case 'K':
  573.     SNARFWORD;
  574.     if (strEQ(d,"keys"))
  575.         *d = toupper(*d);
  576.     else if (strEQ(d,"kill"))
  577.         *d = toupper(*d);
  578.     ID(d);
  579.     case 'l': case 'L':
  580.     SNARFWORD;
  581.     if (strEQ(d,"length")) {
  582.         yylval = OLENGTH;
  583.         XTERM(FUN1);
  584.     }
  585.     if (strEQ(d,"log")) {
  586.         yylval = OLOG;
  587.         XTERM(FUN1);
  588.     }
  589.     if (strEQ(d,"last"))
  590.         *d = toupper(*d);
  591.     else if (strEQ(d,"local"))
  592.         *d = toupper(*d);
  593.     else if (strEQ(d,"lt"))
  594.         *d = toupper(*d);
  595.     else if (strEQ(d,"le"))
  596.         *d = toupper(*d);
  597.     else if (strEQ(d,"locatime"))
  598.         *d = toupper(*d);
  599.     else if (strEQ(d,"link"))
  600.         *d = toupper(*d);
  601.     ID(d);
  602.     case 'm': case 'M':
  603.     SNARFWORD;
  604.     if (strEQ(d,"match")) {
  605.         set_array_base = TRUE;
  606.         XTERM(MATCH);
  607.     }
  608.     if (strEQ(d,"m"))
  609.         *d = toupper(*d);
  610.     ID(d);
  611.     case 'n': case 'N':
  612.     SNARFWORD;
  613.     if (strEQ(d,"NF"))
  614.         do_chop = do_split = split_to_array = set_array_base = TRUE;
  615.     if (strEQ(d,"next")) {
  616.         saw_line_op = TRUE;
  617.         XTERM(NEXT);
  618.     }
  619.     if (strEQ(d,"ne"))
  620.         *d = toupper(*d);
  621.     ID(d);
  622.     case 'o': case 'O':
  623.     SNARFWORD;
  624.     if (strEQ(d,"ORS")) {
  625.         saw_ORS = TRUE;
  626.         d = "\\";
  627.     }
  628.     if (strEQ(d,"OFS")) {
  629.         saw_OFS = TRUE;
  630.         d = ",";
  631.     }
  632.     if (strEQ(d,"OFMT")) {
  633.         d = "#";
  634.     }
  635.     if (strEQ(d,"open"))
  636.         *d = toupper(*d);
  637.     else if (strEQ(d,"ord"))
  638.         *d = toupper(*d);
  639.     else if (strEQ(d,"oct"))
  640.         *d = toupper(*d);
  641.     ID(d);
  642.     case 'p': case 'P':
  643.     SNARFWORD;
  644.     if (strEQ(d,"print")) {
  645.         XTERM(PRINT);
  646.     }
  647.     if (strEQ(d,"printf")) {
  648.         XTERM(PRINTF);
  649.     }
  650.     if (strEQ(d,"push"))
  651.         *d = toupper(*d);
  652.     else if (strEQ(d,"pop"))
  653.         *d = toupper(*d);
  654.     ID(d);
  655.     case 'q': case 'Q':
  656.     SNARFWORD;
  657.     ID(d);
  658.     case 'r': case 'R':
  659.     SNARFWORD;
  660.     if (strEQ(d,"RS")) {
  661.         d = "/";
  662.         saw_RS = TRUE;
  663.     }
  664.     if (strEQ(d,"rand")) {
  665.         yylval = ORAND;
  666.         XTERM(FUN1);
  667.     }
  668.     if (strEQ(d,"return"))
  669.         XTERM(RET);
  670.     if (strEQ(d,"reset"))
  671.         *d = toupper(*d);
  672.     else if (strEQ(d,"redo"))
  673.         *d = toupper(*d);
  674.     else if (strEQ(d,"rename"))
  675.         *d = toupper(*d);
  676.     ID(d);
  677.     case 's': case 'S':
  678.     SNARFWORD;
  679.     if (strEQ(d,"split")) {
  680.         set_array_base = TRUE;
  681.         XOP(SPLIT);
  682.     }
  683.     if (strEQ(d,"substr")) {
  684.         set_array_base = TRUE;
  685.         XTERM(SUBSTR);
  686.     }
  687.     if (strEQ(d,"sub"))
  688.         XTERM(SUB);
  689.     if (strEQ(d,"sprintf"))
  690.         XTERM(SPRINTF);
  691.     if (strEQ(d,"sqrt")) {
  692.         yylval = OSQRT;
  693.         XTERM(FUN1);
  694.     }
  695.     if (strEQ(d,"SUBSEP")) {
  696.         d = ";";
  697.     }
  698.     if (strEQ(d,"sin")) {
  699.         yylval = OSIN;
  700.         XTERM(FUN1);
  701.     }
  702.     if (strEQ(d,"srand")) {
  703.         yylval = OSRAND;
  704.         XTERM(FUN1);
  705.     }
  706.     if (strEQ(d,"system")) {
  707.         yylval = OSYSTEM;
  708.         XTERM(FUN1);
  709.     }
  710.     if (strEQ(d,"s"))
  711.         *d = toupper(*d);
  712.     else if (strEQ(d,"shift"))
  713.         *d = toupper(*d);
  714.     else if (strEQ(d,"select"))
  715.         *d = toupper(*d);
  716.     else if (strEQ(d,"seek"))
  717.         *d = toupper(*d);
  718.     else if (strEQ(d,"stat"))
  719.         *d = toupper(*d);
  720.     else if (strEQ(d,"study"))
  721.         *d = toupper(*d);
  722.     else if (strEQ(d,"sleep"))
  723.         *d = toupper(*d);
  724.     else if (strEQ(d,"symlink"))
  725.         *d = toupper(*d);
  726.     else if (strEQ(d,"sort"))
  727.         *d = toupper(*d);
  728.     ID(d);
  729.     case 't': case 'T':
  730.     SNARFWORD;
  731.     if (strEQ(d,"tr"))
  732.         *d = toupper(*d);
  733.     else if (strEQ(d,"tell"))
  734.         *d = toupper(*d);
  735.     else if (strEQ(d,"time"))
  736.         *d = toupper(*d);
  737.     else if (strEQ(d,"times"))
  738.         *d = toupper(*d);
  739.     ID(d);
  740.     case 'u': case 'U':
  741.     SNARFWORD;
  742.     if (strEQ(d,"until"))
  743.         *d = toupper(*d);
  744.     else if (strEQ(d,"unless"))
  745.         *d = toupper(*d);
  746.     else if (strEQ(d,"umask"))
  747.         *d = toupper(*d);
  748.     else if (strEQ(d,"unshift"))
  749.         *d = toupper(*d);
  750.     else if (strEQ(d,"unlink"))
  751.         *d = toupper(*d);
  752.     else if (strEQ(d,"utime"))
  753.         *d = toupper(*d);
  754.     ID(d);
  755.     case 'v': case 'V':
  756.     SNARFWORD;
  757.     if (strEQ(d,"values"))
  758.         *d = toupper(*d);
  759.     ID(d);
  760.     case 'w': case 'W':
  761.     SNARFWORD;
  762.     if (strEQ(d,"while"))
  763.         XTERM(WHILE);
  764.     if (strEQ(d,"write"))
  765.         *d = toupper(*d);
  766.     else if (strEQ(d,"wait"))
  767.         *d = toupper(*d);
  768.     ID(d);
  769.     case 'x': case 'X':
  770.     SNARFWORD;
  771.     if (strEQ(d,"x"))
  772.         *d = toupper(*d);
  773.     ID(d);
  774.     case 'y': case 'Y':
  775.     SNARFWORD;
  776.     if (strEQ(d,"y"))
  777.         *d = toupper(*d);
  778.     ID(d);
  779.     case 'z': case 'Z':
  780.     SNARFWORD;
  781.     ID(d);
  782.     }
  783. }
  784.  
  785. char *
  786. scanpat(s)
  787. register char *s;
  788. {
  789.     register char *d;
  790.  
  791.     switch (*s++) {
  792.     case '/':
  793.     break;
  794.     default:
  795.     fatal("Search pattern not found:\n%s",str_get(linestr));
  796.     }
  797.  
  798.     d = tokenbuf;
  799.     for (; *s; s++,d++) {
  800.     if (*s == '\\') {
  801.         if (s[1] == '/')
  802.         *d++ = *s++;
  803.         else if (s[1] == '\\')
  804.         *d++ = *s++;
  805.     }
  806.     else if (*s == '[') {
  807.         *d++ = *s++;
  808.         do {
  809.         if (*s == '\\' && s[1])
  810.             *d++ = *s++;
  811.         if (*s == '/' || (*s == '-' && s[1] == ']'))
  812.             *d++ = '\\';
  813.         *d++ = *s++;
  814.         } while (*s && *s != ']');
  815.     }
  816.     else if (*s == '/')
  817.         break;
  818.     *d = *s;
  819.     }
  820.     *d = '\0';
  821.  
  822.     if (!*s)
  823.     fatal("Search pattern not terminated:\n%s",str_get(linestr));
  824.     s++;
  825.     yylval = string(tokenbuf,0);
  826.     return s;
  827. }
  828.  
  829. yyerror(s)
  830. char *s;
  831. {
  832.     fprintf(stderr,"%s in file %s at line %d\n",
  833.       s,filename,line);
  834. }
  835.  
  836. char *
  837. scannum(s)
  838. register char *s;
  839. {
  840.     register char *d;
  841.  
  842.     switch (*s) {
  843.     case '1': case '2': case '3': case '4': case '5':
  844.     case '6': case '7': case '8': case '9': case '0' : case '.':
  845.     d = tokenbuf;
  846.     while (isdigit(*s)) {
  847.         *d++ = *s++;
  848.     }
  849.     if (*s == '.' && index("0123456789eE",s[1])) {
  850.         *d++ = *s++;
  851.         while (isdigit(*s)) {
  852.         *d++ = *s++;
  853.         }
  854.     }
  855.     if (index("eE",*s) && index("+-0123456789",s[1])) {
  856.         *d++ = *s++;
  857.         if (*s == '+' || *s == '-')
  858.         *d++ = *s++;
  859.         while (isdigit(*s))
  860.         *d++ = *s++;
  861.     }
  862.     *d = '\0';
  863.     yylval = string(tokenbuf,0);
  864.     break;
  865.     }
  866.     return s;
  867. }
  868.  
  869. string(ptr,len)
  870. char *ptr;
  871. {
  872.     int retval = mop;
  873.  
  874.     ops[mop++].ival = OSTRING + (1<<8);
  875.     if (!len)
  876.     len = strlen(ptr);
  877.     ops[mop].cval = safemalloc(len+1);
  878.     strncpy(ops[mop].cval,ptr,len);
  879.     ops[mop++].cval[len] = '\0';
  880.     if (mop >= OPSMAX)
  881.     fatal("Recompile a2p with larger OPSMAX\n");
  882.     return retval;
  883. }
  884.  
  885. oper0(type)
  886. int type;
  887. {
  888.     int retval = mop;
  889.  
  890.     if (type > 255)
  891.     fatal("type > 255 (%d)\n",type);
  892.     ops[mop++].ival = type;
  893.     if (mop >= OPSMAX)
  894.     fatal("Recompile a2p with larger OPSMAX\n");
  895.     return retval;
  896. }
  897.  
  898. oper1(type,arg1)
  899. int type;
  900. int arg1;
  901. {
  902.     int retval = mop;
  903.  
  904.     if (type > 255)
  905.     fatal("type > 255 (%d)\n",type);
  906.     ops[mop++].ival = type + (1<<8);
  907.     ops[mop++].ival = arg1;
  908.     if (mop >= OPSMAX)
  909.     fatal("Recompile a2p with larger OPSMAX\n");
  910.     return retval;
  911. }
  912.  
  913. oper2(type,arg1,arg2)
  914. int type;
  915. int arg1;
  916. int arg2;
  917. {
  918.     int retval = mop;
  919.  
  920.     if (type > 255)
  921.     fatal("type > 255 (%d)\n",type);
  922.     ops[mop++].ival = type + (2<<8);
  923.     ops[mop++].ival = arg1;
  924.     ops[mop++].ival = arg2;
  925.     if (mop >= OPSMAX)
  926.     fatal("Recompile a2p with larger OPSMAX\n");
  927.     return retval;
  928. }
  929.  
  930. oper3(type,arg1,arg2,arg3)
  931. int type;
  932. int arg1;
  933. int arg2;
  934. int arg3;
  935. {
  936.     int retval = mop;
  937.  
  938.     if (type > 255)
  939.     fatal("type > 255 (%d)\n",type);
  940.     ops[mop++].ival = type + (3<<8);
  941.     ops[mop++].ival = arg1;
  942.     ops[mop++].ival = arg2;
  943.     ops[mop++].ival = arg3;
  944.     if (mop >= OPSMAX)
  945.     fatal("Recompile a2p with larger OPSMAX\n");
  946.     return retval;
  947. }
  948.  
  949. oper4(type,arg1,arg2,arg3,arg4)
  950. int type;
  951. int arg1;
  952. int arg2;
  953. int arg3;
  954. int arg4;
  955. {
  956.     int retval = mop;
  957.  
  958.     if (type > 255)
  959.     fatal("type > 255 (%d)\n",type);
  960.     ops[mop++].ival = type + (4<<8);
  961.     ops[mop++].ival = arg1;
  962.     ops[mop++].ival = arg2;
  963.     ops[mop++].ival = arg3;
  964.     ops[mop++].ival = arg4;
  965.     if (mop >= OPSMAX)
  966.     fatal("Recompile a2p with larger OPSMAX\n");
  967.     return retval;
  968. }
  969.  
  970. oper5(type,arg1,arg2,arg3,arg4,arg5)
  971. int type;
  972. int arg1;
  973. int arg2;
  974. int arg3;
  975. int arg4;
  976. int arg5;
  977. {
  978.     int retval = mop;
  979.  
  980.     if (type > 255)
  981.     fatal("type > 255 (%d)\n",type);
  982.     ops[mop++].ival = type + (5<<8);
  983.     ops[mop++].ival = arg1;
  984.     ops[mop++].ival = arg2;
  985.     ops[mop++].ival = arg3;
  986.     ops[mop++].ival = arg4;
  987.     ops[mop++].ival = arg5;
  988.     if (mop >= OPSMAX)
  989.     fatal("Recompile a2p with larger OPSMAX\n");
  990.     return retval;
  991. }
  992.  
  993. int depth = 0;
  994.  
  995. dump(branch)
  996. int branch;
  997. {
  998.     register int type;
  999.     register int len;
  1000.     register int i;
  1001.  
  1002.     type = ops[branch].ival;
  1003.     len = type >> 8;
  1004.     type &= 255;
  1005.     for (i=depth; i; i--)
  1006.     printf(" ");
  1007.     if (type == OSTRING) {
  1008.     printf("%-5d\"%s\"\n",branch,ops[branch+1].cval);
  1009.     }
  1010.     else {
  1011.     printf("(%-5d%s %d\n",branch,opname[type],len);
  1012.     depth++;
  1013.     for (i=1; i<=len; i++)
  1014.         dump(ops[branch+i].ival);
  1015.     depth--;
  1016.     for (i=depth; i; i--)
  1017.         printf(" ");
  1018.     printf(")\n");
  1019.     }
  1020. }
  1021.  
  1022. bl(arg,maybe)
  1023. int arg;
  1024. int maybe;
  1025. {
  1026.     if (!arg)
  1027.     return 0;
  1028.     else if ((ops[arg].ival & 255) != OBLOCK)
  1029.     return oper2(OBLOCK,arg,maybe);
  1030.     else if ((ops[arg].ival >> 8) < 2)
  1031.     return oper2(OBLOCK,ops[arg+1].ival,maybe);
  1032.     else
  1033.     return arg;
  1034. }
  1035.  
  1036. fixup(str)
  1037. STR *str;
  1038. {
  1039.     register char *s;
  1040.     register char *t;
  1041.  
  1042.     for (s = str->str_ptr; *s; s++) {
  1043.     if (*s == ';' && s[1] == ' ' && s[2] == '\n') {
  1044.         strcpy(s+1,s+2);
  1045.         s++;
  1046.     }
  1047.     else if (*s == '\n') {
  1048.         for (t = s+1; isspace(*t & 127); t++) ;
  1049.         t--;
  1050.         while (isspace(*t & 127) && *t != '\n') t--;
  1051.         if (*t == '\n' && t-s > 1) {
  1052.         if (s[-1] == '{')
  1053.             s--;
  1054.         strcpy(s+1,t);
  1055.         }
  1056.         s++;
  1057.     }
  1058.     }
  1059. }
  1060.  
  1061. putlines(str)
  1062. STR *str;
  1063. {
  1064.     register char *d, *s, *t, *e;
  1065.     register int pos, newpos;
  1066.  
  1067.     d = tokenbuf;
  1068.     pos = 0;
  1069.     for (s = str->str_ptr; *s; s++) {
  1070.     *d++ = *s;
  1071.     pos++;
  1072.     if (*s == '\n') {
  1073.         *d = '\0';
  1074.         d = tokenbuf;
  1075.         pos = 0;
  1076.         putone();
  1077.     }
  1078.     else if (*s == '\t')
  1079.         pos += 7;
  1080.     if (pos > 78) {        /* split a long line? */
  1081.         *d-- = '\0';
  1082.         newpos = 0;
  1083.         for (t = tokenbuf; isspace(*t & 127); t++) {
  1084.         if (*t == '\t')
  1085.             newpos += 8;
  1086.         else
  1087.             newpos += 1;
  1088.         }
  1089.         e = d;
  1090.         while (d > tokenbuf && (*d != ' ' || d[-1] != ';'))
  1091.         d--;
  1092.         if (d < t+10) {
  1093.         d = e;
  1094.         while (d > tokenbuf &&
  1095.           (*d != ' ' || d[-1] != '|' || d[-2] != '|') )
  1096.             d--;
  1097.         }
  1098.         if (d < t+10) {
  1099.         d = e;
  1100.         while (d > tokenbuf &&
  1101.           (*d != ' ' || d[-1] != '&' || d[-2] != '&') )
  1102.             d--;
  1103.         }
  1104.         if (d < t+10) {
  1105.         d = e;
  1106.         while (d > tokenbuf && (*d != ' ' || d[-1] != ','))
  1107.             d--;
  1108.         }
  1109.         if (d < t+10) {
  1110.         d = e;
  1111.         while (d > tokenbuf && *d != ' ')
  1112.             d--;
  1113.         }
  1114.         if (d > t+3) {
  1115.                 char save[2048];
  1116.                 strcpy(save, d);
  1117.         *d = '\n';
  1118.                 d[1] = '\0';
  1119.         putone();
  1120.         putchar('\n');
  1121.         if (d[-1] != ';' && !(newpos % 4)) {
  1122.             *t++ = ' ';
  1123.             *t++ = ' ';
  1124.             newpos += 2;
  1125.         }
  1126.         strcpy(t,save+1);
  1127.         newpos += strlen(t);
  1128.         d = t + strlen(t);
  1129.         pos = newpos;
  1130.         }
  1131.         else
  1132.         d = e + 1;
  1133.     }
  1134.     }
  1135. }
  1136.  
  1137. putone()
  1138. {
  1139.     register char *t;
  1140.  
  1141.     for (t = tokenbuf; *t; t++) {
  1142.     *t &= 127;
  1143.     if (*t == 127) {
  1144.         *t = ' ';
  1145.         strcpy(t+strlen(t)-1, "\t#???\n");
  1146.         checkers++;
  1147.     }
  1148.     }
  1149.     t = tokenbuf;
  1150.     if (*t == '#') {
  1151.     if (strnEQ(t,"#!/bin/awk",10) || strnEQ(t,"#! /bin/awk",11))
  1152.         return;
  1153.     if (strnEQ(t,"#!/usr/bin/awk",14) || strnEQ(t,"#! /usr/bin/awk",15))
  1154.         return;
  1155.     }
  1156.     fputs(tokenbuf,stdout);
  1157. }
  1158.  
  1159. numary(arg)
  1160. int arg;
  1161. {
  1162.     STR *key;
  1163.     int dummy;
  1164.  
  1165.     key = walk(0,0,arg,&dummy,P_MIN);
  1166.     str_cat(key,"[]");
  1167.     hstore(symtab,key->str_ptr,str_make("1"));
  1168.     str_free(key);
  1169.     set_array_base = TRUE;
  1170.     return arg;
  1171. }
  1172.  
  1173. rememberargs(arg)
  1174. int arg;
  1175. {
  1176.     int type;
  1177.     STR *str;
  1178.  
  1179.     if (!arg)
  1180.     return arg;
  1181.     type = ops[arg].ival & 255;
  1182.     if (type == OCOMMA) {
  1183.     rememberargs(ops[arg+1].ival);
  1184.     rememberargs(ops[arg+3].ival);
  1185.     }
  1186.     else if (type == OVAR) {
  1187.     str = str_new(0);
  1188.     hstore(curarghash,ops[ops[arg+1].ival+1].cval,str);
  1189.     }
  1190.     else
  1191.     fatal("panic: unknown argument type %d, line %d\n",type,line);
  1192.     return arg;
  1193. }
  1194.  
  1195. aryrefarg(arg)
  1196. int arg;
  1197. {
  1198.     int type = ops[arg].ival & 255;
  1199.     STR *str;
  1200.  
  1201.     if (type != OSTRING)
  1202.     fatal("panic: aryrefarg %d, line %d\n",type,line);
  1203.     str = hfetch(curarghash,ops[arg+1].cval);
  1204.     if (str)
  1205.     str_set(str,"*");
  1206.     return arg;
  1207. }
  1208.  
  1209. fixfargs(name,arg,prevargs)
  1210. int name;
  1211. int arg;
  1212. int prevargs;
  1213. {
  1214.     int type;
  1215.     STR *str;
  1216.     int numargs;
  1217.  
  1218.     if (!arg)
  1219.     return prevargs;
  1220.     type = ops[arg].ival & 255;
  1221.     if (type == OCOMMA) {
  1222.     numargs = fixfargs(name,ops[arg+1].ival,prevargs);
  1223.     numargs = fixfargs(name,ops[arg+3].ival,numargs);
  1224.     }
  1225.     else if (type == OVAR) {
  1226.     str = hfetch(curarghash,ops[ops[arg+1].ival+1].cval);
  1227.     if (strEQ(str_get(str),"*")) {
  1228.         char tmpbuf[128];
  1229.  
  1230.         str_set(str,"");        /* in case another routine has this */
  1231.         ops[arg].ival &= ~255;
  1232.         ops[arg].ival |= OSTAR;
  1233.         sprintf(tmpbuf,"%s:%d",ops[name+1].cval,prevargs);
  1234.         fprintf(stderr,"Adding %s\n",tmpbuf);
  1235.         str = str_new(0);
  1236.         str_set(str,"*");
  1237.         hstore(curarghash,tmpbuf,str);
  1238.     }
  1239.     numargs = prevargs + 1;
  1240.     }
  1241.     else
  1242.     fatal("panic: unknown argument type %d, arg %d, line %d\n",
  1243.       type,prevargs+1,line);
  1244.     return numargs;
  1245. }
  1246.  
  1247. fixrargs(name,arg,prevargs)
  1248. char *name;
  1249. int arg;
  1250. int prevargs;
  1251. {
  1252.     int type;
  1253.     STR *str;
  1254.     int numargs;
  1255.  
  1256.     if (!arg)
  1257.     return prevargs;
  1258.     type = ops[arg].ival & 255;
  1259.     if (type == OCOMMA) {
  1260.     numargs = fixrargs(name,ops[arg+1].ival,prevargs);
  1261.     numargs = fixrargs(name,ops[arg+3].ival,numargs);
  1262.     }
  1263.     else {
  1264.     char tmpbuf[128];
  1265.  
  1266.     sprintf(tmpbuf,"%s:%d",name,prevargs);
  1267.     str = hfetch(curarghash,tmpbuf);
  1268.     fprintf(stderr,"Looking for %s\n",tmpbuf);
  1269.     if (str && strEQ(str->str_ptr,"*")) {
  1270.         if (type == OVAR || type == OSTAR) {
  1271.         ops[arg].ival &= ~255;
  1272.         ops[arg].ival |= OSTAR;
  1273.         }
  1274.         else
  1275.         fatal("Can't pass expression by reference as arg %d of %s\n",
  1276.             prevargs+1, name);
  1277.     }
  1278.     numargs = prevargs + 1;
  1279.     }
  1280.     return numargs;
  1281. }
  1282.  
  1283.